home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
tool_inc.zip
/
TREELIB.INC
< prev
next >
Wrap
Text File
|
1989-06-02
|
6KB
|
246 lines
(*
* Copyright 1987, 1989 Samuel H. Smith; All rights reserved
*
* This is a component of the ProDoor System.
* Do not distribute modified versions without my permission.
* Do not remove or alter this notice or any other copyright notice.
* If you use this in your own program you must distribute source code.
* Do not use any of this in a commercial product.
*
*)
(*
* treelib.inc - Utility library to build, sort and output trees
* in a real visual "tree" format. (3-1-89)
*
*)
const
maxsubs = 150; {maximum number of subnodes for
any single node in the tree}
ascii_tree: boolean = false; {set to true for ASCII only tree
output; full IBM character set is
used by default}
type
long_string = string[255]; {maximum length of an output line}
subnode_index = 0..maxsubs;
name_string = string[40]; {maximum length of the name of a single
tree node}
subnode_table = ^subnode_tabletype;
node_ptr = ^node_rec;
subnode_tabletype = array[1..maxsubs] of node_ptr;
node_rec = record
name: name_string; {the name of the node}
count: subnode_index; {the count of subnodes}
subs: subnode_table; {pointer to subnode table, if any}
end;
type
connector_codes =
(horizontal, tee, top, cross, middle, bottom, vertical, spaces, empty);
const
connector_strings: array [boolean, connector_codes] of string[3] =
(('───', '─┬─', ' ┌─', '─┼─', ' ├─', ' └─', ' │ ', ' ', ''),
('---', '-+-', ' +-', '-|-', ' |-', ' +-', ' | ', ' ', ''));
(*
* new_node - create and return a new empty node
*
* note: the subnode table node^.subs must be allocated
* by the user before any subnodes can be
* created. this was done to eliminate the
* space needed by the subnode table on the
* terminal nodes in the tree.
*
*)
function new_node: node_ptr;
var
node: node_ptr;
i: subnode_index;
begin
new (node);
node^.name := '';
node^.count := 0;
node^.subs := nil;
new_node := node;
end;
(*
* dispose_tree - dispose of a tree
*
*)
procedure dispose_tree(var node: node_ptr);
var
i: subnode_index;
begin
if node <> nil then
begin
with node^ do
for i := 1 to count do
dispose_tree(subs^[i]);
if node^.subs <> nil then
dispose(node^.subs);
dispose(node);
node := nil;
end;
end;
(*
* sort_node - sort the entries in a node
*
*)
procedure sort_node(node: node_ptr);
var
i: subnode_index;
swapped: boolean;
temp: node_ptr;
begin
with node^ do
repeat
swapped := false;
for i := 1 to count-1 do
if subs^[i]^.name > subs^[i+1]^.name then
begin
temp := subs^[i];
subs^[i] := subs^[i+1];
subs^[i+1] := temp;
swapped := true;
end;
until swapped = false;
end;
function blanks (len: integer): long_string;
var
str: long_string;
begin
str := '';
while length (str) < len do
str := str + ' ';
blanks := str;
end;
function connector (code: connector_codes): long_string;
begin
connector := connector_strings [ascii_tree, code];
end;
procedure put_node (var fd: text; {output file}
node: node_ptr; {node to output}
beforetab: long_string; {tabs if before title}
titletab: long_string; {tabs for title}
aftertab: long_string; {tabs if after title}
before: connector_codes; {next tab before title}
title: connector_codes; {next tab for title}
after: connector_codes); {next tab after title}
var
i: subnode_index;
titlesub: subnode_index;
begin
with node^ do
begin
beforetab := beforetab + connector (before) + blanks (length (name));
titletab := titletab + connector (title ) + name;
aftertab := aftertab + connector (after ) + blanks (length (name));
case count of
0: {terminal node with title only}
writeln (fd, titletab);
1: {node with 1 subnode}
put_node (fd, subs^[1], beforetab, titletab, aftertab,
spaces, horizontal, spaces);
2: {node with 2 subnodes}
begin
put_node (fd, subs^[1], beforetab, titletab, aftertab,
spaces, tee, vertical);
put_node (fd, subs^[2], aftertab, aftertab, aftertab,
vertical, bottom, spaces);
end;
else {node with n subnodes}
begin
titlesub := (count+1) div 2;
writeln (fd, beforetab);
put_node (fd, subs^[1], beforetab, beforetab, beforetab,
spaces, top, vertical);
for i := 2 to titlesub-1 do
put_node (fd, subs^[i], beforetab, beforetab, beforetab,
vertical, middle, vertical);
put_node (fd, subs^[titlesub], beforetab, titletab, aftertab,
vertical, cross, vertical);
for i := titlesub+1 to count-1 do
put_node (fd, subs^[i], aftertab, aftertab, aftertab,
vertical, middle, vertical);
put_node (fd, subs^[count], aftertab, aftertab, aftertab,
vertical, bottom, spaces);
end;
end;
end;
end;
(*
* put_tree - format a tree for output and write it to a file
*
*)
procedure put_tree (var fd: text;
root: node_ptr);
begin
put_node (fd, root, '', '', '', empty, empty, empty);
flush (fd);
end;